home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / a / a_funk / satellit.tos / SATELLIT / SAT_SOUR.TXT / PACSPLIT.GFA < prev    next >
Encoding:
Text File  |  1995-04-30  |  4.1 KB  |  178 lines
  1. bbs> Msg# 75755   To: ATARI @ALLE   From: DL6DBN   Date: 13Sep90/1124
  2. Subject: PACSAT-Broadcast-Splitter
  3. Bulletin ID: 139003DB0SGL
  4. Path: DB0IE!DB0GV!DB0LJ!DK0MWX!DB0SGL
  5. de DL6DBN @ DB0SGL
  6.  
  7. Mit dem nachfolgenden Programm können nach einem PACSAT-Umlauf, die unter
  8. dem 6DBN_DAT Format (siehe auch "Satelliten-Datensammler" unter ATARI) ab-
  9. gespeicherten Broadcastpakete in bis zu 12 verschiedene Dateien aufgesplit-
  10. tet werden. Es wird noch keine Prüfsummen gebildet und kontrolliert.
  11.  
  12. Zum Programmverständnis ist eine gewisse Kenntnis des PACSAT Broadcast
  13. Protokolls notwendig.
  14.  
  15. 73 Frank, DL6DBN @ DB0SGL
  16.  
  17. own_call$="DL6DBN" ! zum eintragen in das Downloader-Feld
  18. '
  19. DIM stream$(12),index%(12),fsize%(12)
  20. FOR i%=0 TO 12
  21.   stream$(i%)=STRING$(32767,0)
  22.   index%(i%)=0
  23. NEXT i%
  24. CLS
  25. PRINT "  Select Log-File :"
  26. FILESELECT "\*.*","",name$
  27. IF name$=""
  28.   END
  29. ENDIF
  30. IF NOT EXIST(name$)
  31.   ALERT 1,"|File doesn't exist !",1," OK ",dummy%
  32.   END
  33. ENDIF
  34. OPEN "I",#10,name$
  35. INPUT #10,fhd$
  36. IF LEFT$(fhd$,8)<>"6DBN_DAT"
  37.   ALERT 1,"|Wrong File-format !",1," OK ",dummy%
  38.   END
  39. ENDIF
  40. CLS
  41. WHILE NOT EOF(#10)
  42.   INPUT #10,hd$
  43.   IF INSTR(hd$," pid ")
  44.     len%=INP(#10)
  45.     frm$=INPUT$(len%+1,#10)
  46.   ENDIF
  47.   IF INSTR(hd$," to QST-1 ") AND INSTR(hd$," pid BB")
  48.     flag%=ASC(LEFT$(frm$,1))
  49.     IF (flag% AND 2)=2
  50.       offset%=0
  51.       FOR i%=0 TO 2
  52.         offset%=offset%+ASC(MID$(frm$,7+i%,1))*256^i%
  53.       NEXT i%
  54.     ENDIF
  55.     IF (flag% AND 1)=1
  56.       length%=ASC(MID$(frm$,10,1))
  57.       start%=11
  58.     ELSE
  59.       start%=10
  60.       length%=len%-start%
  61.     ENDIF
  62.     file_type%=ASC(MID$(frm$,6,1))
  63.     file_id%=0
  64.     FOR i%=0 TO 3
  65.       file_id%=file_id%+ASC(MID$(frm$,2+i%,1))*256^i%
  66.       ptr%=0
  67.       FOR j%=1 TO 12
  68.         EXIT IF file_id%=index%(j%)
  69.       NEXT j%
  70.       IF j%<=12
  71.         ptr%=j%
  72.       ELSE
  73.         FOR j%=1 TO 12
  74.           EXIT IF index%(j%)=0
  75.         NEXT j%
  76.         IF j%<=12
  77.           index%(j%)=file_id%
  78.           ptr%=j%
  79.           PRINT AT(1,j%*2-1);"Stream opened : id ";HEX$(index%(j%));" type ";HEX$(file_type%);" as ";ptr%;
  80.         ELSE
  81.           PRINT AT(1,25);"Too many streams";
  82.         ENDIF
  83.       ENDIF
  84.     NEXT i%
  85.     IF MID$(frm$,start%,2)="¬U"
  86.       @fileheader
  87.     ENDIF
  88.     IF (offset%+length%)<32767
  89.       MID$(stream$(ptr%),offset%+1,length%)=MID$(frm$,start%,length%)
  90.     ELSE
  91.       PRINT AT(42,ptr%*2-1);"Stream Overflow";
  92.     ENDIF
  93.   ENDIF
  94. WEND
  95. CLOSE #10
  96. CLS
  97. PRINT "  Select Directory to write :"
  98. FILESELECT "\*.*","",dr$
  99. FOR i%=LEN(dr$) TO 1 STEP -1
  100.   EXIT IF MID$(dr$,i%,1)="\"
  101. NEXT i%
  102. dr$=LEFT$(dr$,i%)
  103. CLS
  104. FOR i%=1 TO 12
  105.   IF index%(i%)<>0
  106.     hex_name$=dr$+HEX$(index%(i%))
  107.     PRINT "Writing Stream ";i%;" to ";hex_name$
  108.     OPEN "O",#2,hex_name$
  109.     PRINT #2,LEFT$(stream$(i%),fsize%(i%));
  110.     CLOSE #2
  111.   ENDIF
  112. NEXT i%
  113. END
  114. '
  115. PROCEDURE fileheader
  116.   hend$=STRING$(3,0)
  117.   PRINT AT(3,ptr%*2);"PFH: ";
  118.   hpos%=start%+2
  119.   WHILE MID$(frm$,hpos%,3)<>hend$
  120.     hd_id%=ASC(MID$(frm$,hpos%,1))
  121.     hd_len%=ASC(MID$(frm$,hpos%+2,1))
  122.     hpos%=hpos%+3
  123.     hd_data$=MID$(frm$,hpos%,hd_len%)
  124.     IF hd_id%>=1 AND hd_id%<=11
  125.       ON hd_id% GOSUB nil,file_name,file_ext,file_size,nil,nil,seu_flag,nil,nil,nil,nil
  126.     ENDIF
  127.     IF hd_id%>=16 AND hd_id%<=21
  128.       ON hd_id%-15 GOSUB source,uploader,nil,nil,destination,downloader
  129.     ENDIF
  130.     hpos%=hpos%+hd_len%
  131.   WEND
  132.   PRINT AT(8,ptr%*2);finame$;".";fext$;" fm ";src$;" upl ";upl$;" to ";dest$;" size ";size%;" seu ";seu%;
  133. RETURN
  134. '
  135. PROCEDURE nil
  136. RETURN
  137. '
  138. PROCEDURE file_name
  139.   finame$=hd_data$
  140. RETURN
  141. '
  142. PROCEDURE file_ext
  143.   fext$=hd_data$
  144. RETURN
  145. '
  146. PROCEDURE file_size
  147.   size%=0
  148.   FOR k%=1 TO hd_len%
  149.     size%=size%+ASC(MID$(hd_data$,k%,1))*256^(k%-1)
  150.   NEXT k%
  151.   IF size%<=32767
  152.     fsize%(ptr%)=size%
  153.   ELSE
  154.     fsize%(ptr%)=32767
  155.   ENDIF
  156. RETURN
  157. '
  158. PROCEDURE seu_flag
  159.   seu%=ASC(LEFT$(hd_data$,1))
  160. RETURN
  161. '
  162. PROCEDURE source
  163.   src$=hd_data$
  164. RETURN
  165. '
  166. PROCEDURE uploader
  167.   upl$=hd_data$
  168. RETURN
  169. '
  170. PROCEDURE destination
  171.   dest$=hd_data$
  172. RETURN
  173. '
  174. PROCEDURE downloader
  175.   MID$(frm$,hpos%,hd_len%)=LEFT$(own_call$,hd_len%)
  176. RETURN
  177.  
  178.